home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / QBIPROC.PRG < prev    next >
Encoding:
Text File  |  1993-10-26  |  5.8 KB  |  222 lines
  1. procedure QBINIT
  2. *                   Q B I N I T . P R G
  3. clear
  4. set date british
  5. set exact off
  6. set talk off
  7. set safety off
  8. set unique off
  9. set bell off
  10. set wrap on
  11. set scoreboard off
  12. set deleted on
  13. set status off
  14. set device to screen
  15. set intensity on
  16. set function 9 to chr(23)
  17. *    Last change:  MIB  11 Aug 93    4:44 pm
  18.  
  19. public QBSAFE, QBTITLE, QBMSGLIN, QBPROC
  20. public COLNORM, COLPWD, COLFLASH, COLHEAD, COLMENU, COLBRIGHT
  21. public COLMON, QBVAT, GETOUT, CHANGED, QBKEY, QBCHOICE
  22. public QBDATE, QBRESP, QBRESPD
  23. private M
  24.  
  25. *       Print intialisation
  26. public PAGENO, PLENGTH, PLINE, PHEAD1, PHEAD2, PHEAD3, PHEAD4, PHEAD5
  27. public PHEAD6, PHEAD7, PHEAD8, PHEAD9
  28. public PHEAD, PDEST, PFOOT, PFOOT1, PFOOT2, PFOOT3, PFOOT4, PFOOT5
  29. public PSTART, PWIDTH,PSET1,PSET2,PSET3,PSET4,PSET5,TPSET1,TPSET2
  30. PDEST = " "
  31. store "" to PHEAD1, PHEAD2, PHEAD3, PHEAD4, PHEAD5, PHEAD6, PHEAD7, PHEAD8, PHEAD9
  32.  
  33. use qbinfo index qbinfo
  34. seek "COLOUR"
  35. COLMON = (trim(QBTEXT) = "C")
  36. seek "PSET1"
  37. mem = trim(QBTEXT)
  38. PSET1 = &mem                   && set system emulation mode
  39. skip
  40. mem = trim(QBTEXT)
  41. PSET5 = PSET1+&mem             && Set  normal text
  42. skip
  43. mem = trim(QBTEXT)
  44. PSET4 = PSET1+&mem             && Set compressed
  45. skip
  46. mem = trim(QBTEXT)
  47. PSET2 = PSET4+&mem             && Set compressed portrait
  48. PSET5 = PSET5+&mem             && Set normal portrait
  49. skip
  50. mem = trim(QBTEXT)
  51. PSET3 = PSET4+&mem             && Set compressed landscape
  52. TPSET1 = PSET2
  53. TPSET2 = PSET5
  54.  
  55. getout = .f.
  56. CHANGED = .f.
  57. qbkey = 0                 && Keystroke returned from qbmenu
  58. QBCHOICE = 1
  59.  
  60. qbtitle = space(30)       && Application title - qbinfo record #1
  61. IF colmon
  62.     colnorm = "W/B,N/W,B,B,W+/B"   && Normal screen colours
  63.     colbright = "W+/B,N/W+,B,B,W+/B"   && Say data high
  64.     colmenu =   "W+/B,N/W+,B,B,W+/B"
  65.     colpwd = "W+/B,B/B,B,B"    && Password screen colours
  66.     colflash = "R*/W,N*/W,B,B" && Flashing message
  67.     colhead = "GR+/B,N/W,B,B,W+/B" && Bright Yellow/Blue
  68. ELSE
  69.     colnorm = "W/N,N/W,,,W+/N"
  70.     colbright = "W+/N,N/W+,,,W+/N"   && Say data high
  71.     colmenu = "W+/N,N/W+"
  72.     colpwd = "N/N,N/N,X"
  73.     colflash = "W*/N,N/W*"
  74.     colhead = "N/W+,W/N,,,W+/N"
  75. ENDIF
  76. qbproc = space(30)        && Procedure name being run
  77. qbmsglin = 0
  78. QBRESP = " "
  79. DO qbindate             && Confirm/Get System date
  80.  
  81. * Get password
  82. DO qblayout WITH "Password Verification"
  83. do QBBOX with 40
  84. set color to (iif(COLMON,COLHEAD,COLBRIGHT))
  85. M = "Quin Butterworth Spangenthal"
  86. @ 9,centre(M) say M
  87. M = "Systems Design & Consultancy"
  88. @ 12,centre(M) say M
  89. M = "for support call"
  90. @ 14,centre(M) say M
  91. M = "081-994-4842"
  92. @ 16,centre(M) say M
  93. set color to (COLNORM)
  94. close database
  95.  
  96. set color to (COLNORM)
  97.  
  98. set exact off
  99. select 0
  100. use QBINFO index QBINFO
  101. SEEK "HEADING"
  102. IF found()
  103.    qbtitle = trim(qbtext)
  104. else
  105.     QBTITLE = "Quin Butterworth Spangenthal"
  106. ENDIF
  107. SEEK "VATRATE"
  108. IF .NOT. eof()
  109.    qbvat = val(qbtext)
  110. else
  111.     qbvat = 17.50
  112. ENDIF
  113.  
  114. RETURN
  115.  
  116. procedure QBINDATE
  117.  
  118. *   Q B I N D A T E . P R G
  119. * Check the system date and get the user to confirm it or change
  120. PRIVATE t, the_date
  121. qbdate = space(29)
  122. * Time bomb could go in here
  123. * data record contains date last used, date to blow up
  124. * if date < date last used error reenter else if
  125. * if date> timebomb date blow up
  126.  
  127. DO qblayout WITH "Q B Systems"
  128. DO qbmess WITH "Checking Date",colflash,0
  129. DO qblstsun     && Delivers the date last sunday...
  130.  
  131. the_date = date()
  132.  
  133. DO WHILE the_date = ctod("01/01/80")
  134.     DO qbgetd WITH "Input today's date" ,"01/01/80"
  135.     qbdate = dtoc(qbrespd)
  136.     RUN date &qbdate
  137.     the_date = date()
  138. ENDDO
  139.  
  140. d = day(the_date)
  141. do case
  142.     case d=1.or.d=21.or.d=31
  143.         store "st" to t
  144.     case d=2.or.d=22
  145.         store "nd" to t
  146.     CASE d=3 .OR. d=23
  147.         store "rd" TO t
  148.     otherwise
  149.         store "th" to t
  150. endcase
  151.  
  152. qbdate = cdow(the_date)+" "+str(day(the_date),2)+t+" ";
  153.         +cmonth(the_date)+" "+str(year(the_date),4)
  154.  
  155. RETURN
  156.  
  157. procedure QBPSETUP
  158.  
  159. CLEAR
  160. @  1,0 to 1,79 double
  161. @  2,0 say "Q.B. Systems Ltd."
  162. @  3,0 to 3,79 double
  163. @ 21,0 to 21,79 double
  164. @ 2,32 SAY "Printer Setup"
  165. use QBINFO index QBINFO
  166. do while .t.
  167.     seek "PSET1"
  168.     MPSET1=QBTEXT
  169.     skip
  170.     MPSET2=QBTEXT
  171.     skip
  172.     MPSET3=QBTEXT
  173.     skip
  174.     MPSET4=QBTEXT
  175.     skip
  176.     MPSET5=QBTEXT
  177.     seek "PSET1"
  178.     do while .t.
  179.         @  6,5 say "Unprintable Decimal ASCII codes should appear as CHR(n) functions"
  180.         @  7,5 say "i.e. Escape is chr(27)"
  181.         @  8,5 say "Printable ASCII codes should appear in single quotes"
  182.         @  9,5 say "i.e. 'ABC'"
  183.         @ 10,5 say "Strings of control codes should be concatenated with '+'"
  184.         @ 11,5 say "i.e. chr(27)+'15'"
  185.         @ 13,10 say "Printer initialisation " get MPSET1
  186.         @ 14,10 say "Normal Characters      " get MPSET2
  187.         @ 15,10 say "Compressed print       " get MPSET3
  188.         @ 16,10 say "Portrait               " get MPSET4
  189.         @ 17,10 say "Landscape              " get MPSET5
  190.         read
  191.         if ["]$MPSET1+MPSET2+MPSET3+MPSET4+MPSET5
  192.             @ 22,2 say  [There is a " in a print setup string! Please use ' instead. Press a key.]
  193.             wait " "
  194.             @ 22,0 clear
  195.         else
  196.             I = QBPROMPT("Save|Edit|Quit|Restart","",1)
  197.             do case
  198.             case QBRESP="Q"
  199.                 use
  200.                 return
  201.             case QBRESP="R"
  202.                 exit
  203.             case QBRESP="S"
  204.                 replace QBTEXT with MPSET1
  205.                 skip
  206.                 replace QBTEXT with MPSET2
  207.                 skip
  208.                 replace QBTEXT with MPSET3
  209.                 skip
  210.                 replace QBTEXT with MPSET4
  211.                 skip
  212.                 replace QBTEXT with MPSET5
  213.                 use
  214.                 return
  215.             endcase
  216.         endif
  217.     enddo
  218. enddo
  219.  
  220. return
  221.  
  222.